home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1999 March / EnigmA AMIGA RUN 35 (1999)(G.R. Edizioni)(IT)[!][issue 1999-03].iso / earcd / grafica / amicad / arexx / tirertraits.amicad < prev    next >
Text File  |  1999-01-01  |  4KB  |  195 lines
  1. /* Décalage et alignement des extrémités d'un ensemble de lignes */
  2. /* Version 1.00 13/01/99 */
  3. /* $VER: 1.01 (© R.Florac, 6/2/99) Ajout UNLOCK */
  4.  
  5. options results
  6.  
  7. signal on error
  8. signal on syntax
  9.  
  10. 'DEF LIGNE(P)=P&0XFFFF'
  11. 'DEF COLONNE(P)=P>>15'
  12. 'LOCK(-1):SELECT("Bout à déplacer?"+CHR(10)+"Gauche"+CHR(10)+"Haut"+CHR(10)+"Droite"+CHR(10)+"Bas")'
  13. d=result
  14. select
  15.     when d=1 then do
  16.     'GETPOINT("Cliquez sur la colonne de destination")'; p=result
  17.     /* 'PLACEOBJ("Placez la ligne sur sa destination", FIRSTSEL, 0)'; p=result */
  18.     if p<0 then exit
  19.     'COLONNE('p')'; col=result
  20.     'SAVEALL(-1):FIRSTSEL'; o=result
  21.     do while o>0
  22.         mode=mode_ligne(o)
  23.         if mode~=-1000 then do
  24.         o = retracer_gauche(o,col,mode)
  25.         end
  26.         else do
  27.         'NEXTSEL('o')'; o=result
  28.         end
  29.     end
  30.     end
  31.     when d=2 then do
  32.     'GETPOINT("Cliquez sur la ligne de destination")'; p=result
  33.     if p<0 then exit
  34.     'LIGNE('p')'; ligne=result
  35.     'SAVEALL(-1):FIRSTSEL'; o=result
  36.     do while o>0
  37.         mode=mode_ligne(o)
  38.         if mode~=-1000 then do
  39.         o = retracer_haut(o,ligne,mode)
  40.         end
  41.         else do
  42.         'NEXTSEL('o')'; o=result
  43.         end
  44.     end
  45.     end
  46.     when d=3 then do
  47.     'GETPOINT("Cliquez sur la colonne de destination")'; p=result
  48.     if p<0 then exit
  49.     'COLONNE('p')'; col=result
  50.     'SAVEALL(-1):FIRSTSEL'; o=result
  51.     do while o>0
  52.         mode=mode_ligne(o)
  53.         if mode~=-1000 then do
  54.         o = retracer_droite(o,col,mode)
  55.         end
  56.         else do
  57.         'NEXTSEL('o')'; o=result
  58.         end
  59.     end
  60.     end
  61.     when d=4 then do
  62.     'GETPOINT("Cliquez sur la ligne de destination")'; p=result
  63.     if p<0 then exit
  64.     'LIGNE('p')'; ligne=result
  65.     'SAVEALL(-1):FIRSTSEL'; o=result
  66.     do while o>0
  67.         mode=mode_ligne(o)
  68.         if mode~=-1000 then do
  69.         o = retracer_bas(o,ligne,mode)
  70.         end
  71.         else do
  72.         'NEXTSEL('o')'; o=result
  73.         end
  74.     end
  75.     end
  76.     otherwise nop
  77. end
  78. 'UNLOCK(-1)'
  79. exit
  80.  
  81. mode_ligne: procedure
  82.     parse arg o
  83.     mode=-1000
  84.     'TYPE('o')'
  85.     select
  86.     when result=2 then mode=1   /* fil */
  87.     when result=15 then mode=2  /* ligne double */
  88.     when result=9 then mode=3   /* bus */
  89.     when result=8 then mode=0   /* pointillés */
  90.     when result=21 then do        /* ligne spéciale */
  91.         'PENWIDTH('o',-10000)'
  92.         mode=0-result
  93.     end
  94.     otherwise nop
  95.     end
  96.     return mode
  97.  
  98. minima: procedure
  99.     parse arg v1,v2
  100.     if v1<v2 then return v1
  101.     return v2
  102. end
  103.  
  104. maxima: procedure
  105.     parse arg v1,v2
  106.     if v1>v2 then return v1
  107.     return v2
  108. end
  109.  
  110. retracer_gauche: procedure
  111.     parse arg o,col,mode
  112.     'COORDS('o')'
  113.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  114.     xg=minima(x0,x1)
  115.     if x0=x1 then x1=col
  116.     if xg=x0 then do
  117.     x2=x1; y2=y1;
  118.     end
  119.     else do
  120.     x2=x0; y2=y0; y0=y1
  121.     end
  122.     'DELETE('o'):DRAWMODE('mode'):DRAW('col','y0','x2','y2')'; no=result
  123.     if no=o then o=0
  124.     else do
  125.     'NEXTSEL('o-1')'; o=result
  126.     end
  127.     return o
  128.  
  129. retracer_haut: procedure
  130.     parse arg o,ligne,mode
  131.     'COORDS('o')'
  132.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  133.     yh=minima(y0,y1)
  134.     if y0=y1 then y1=ligne
  135.     if yh=y0 then do
  136.     y2=y1; x2=x1;
  137.     end
  138.     else do
  139.     y2=y0; x2=x0; x0=x1
  140.     end
  141.     'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
  142.     if no=o then o=0
  143.     else do
  144.     'NEXTSEL('o-1')'; o=result
  145.     end
  146.     return o
  147.  
  148. retracer_droite: procedure
  149.     parse arg o,col,mode
  150.     'COORDS('o')'
  151.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  152.     xd=maxima(x0,x1)
  153.     if x0=x1 then x0=col
  154.     if xd=x1 then do
  155.     x2=x0; y2=y0; y0=y1
  156.     end
  157.     else do
  158.     x2=x1; y2=y1
  159.     end
  160.     'DELETE('o'):DRAWMODE('mode'):DRAW('x2','y2','col','y0')'; no=result
  161.     if no=o then o=0
  162.     else do
  163.     'NEXTSEL('o-1')'; o=result
  164.     end
  165.     return o
  166.  
  167. retracer_bas: procedure
  168.     parse arg o,ligne,mode
  169.     'COORDS('o')'
  170.     PARSE VAR result x0 ',' y0 ',' x1 ',' y1
  171.     yb=maxima(y0,y1)
  172.     if y0=y1 then y1=ligne
  173.     if yb=y0 then do
  174.     y2=y1; x2=x1;
  175.     end
  176.     else do
  177.     y2=y0; x2=x0; x0=x1
  178.     end
  179.     'DELETE('o'):DRAWMODE('mode'):DRAW('x0','ligne','x2','y2')'; no=result
  180.     if no=o then o=0
  181.     else do
  182.     'NEXTSEL('o-1')'; o=result
  183.     end
  184.     return o
  185.  
  186. /* Traitement des erreurs, interruption du programme */
  187. syntax:
  188. erreur=RC
  189. 'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK(-1)'
  190. exit
  191.  
  192. error:
  193. 'MESSAGE("Erreur en ligne 'SIGL'"):UNLOCK(-1)'
  194. exit
  195.